home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 6 / CU Amiga Magazine's Super CD-ROM 06 (1996)(EMAP Images)(GB)(Track 1 of 4)[!][issue 1997-01].iso / cucd / magazine / pd_utils / codecontrol1.0 / codecontrol.rexx < prev    next >
OS/2 REXX Batch file  |  1996-10-13  |  12KB  |  15 lines

  1. /* Compressed with CompressRexx v2.1, (C) 1993-96 Robert Hofmann */
  2. if( ~show( 'l', "rexxsupport.library" ) ) then do;if( ~addlib( "rexxsupport.library", 0, -30, 0 ) )then do;say "Could not open rexxsupport.library";exit 10;end;end;if( ~show( 'l', "rexxtricks.library" ) ) then do;if( ~addlib( "rexxtricks.library", 0, -30, 0 ) )then do;say "Could not open rexxtricks.library";exit 10;end;end;Application_AboutMUI = 0x8042d21d;Application_OpenConfigWindow = 0x804299ba;Disabled = 0x80423661;Ver = 1.00;options results;Parse Arg CodeCmd;if CodeCmd = '' then do;Location = pragma(D);Len = Length(Location);Colon = lastpos(':',Location);if Colon ~= Len then do;Location = Location||'/';end;address CODECONTROL;window ID PAGE TITLE '"CodeControl"' COMMAND 'quit' PORT CODECONTROL;menu LABEL '"Project"';item COMMAND '"method 'Application_AboutMUI' 0"' PORT CODECONTROL LABEL '"About MUI"';menu LABEL '"Settings"';item COMMAND '"method 'Application_OpenConfigWindow'"' PORT CODECONTROL LABEL '"MUI..."';endmenu;item ATTRS Menuitem_Title '-1'
  3. item COMMAND '"quit"' PORT CODECONTROL ATTRS Menuitem_Shortcut 'Q' LABEL '"Quit"';endmenu;group;group FRAME;label CENTER '"CodeControl 'Ver '"';space 2;label CENTER "© Dave Naylor 1996 - Frost Free Amiga BBS";space 2;label CENTER "knocker@frost3.demon.co.uk";space 2;endgroup;group ID ZOOM ATTRS 0x8042f416 2 FRAME LABEL '"Global Options"';label LEFT '"Source File:"';popasl ID UUF HELP '"Source File Location"' CONTENT 'Ram:';label LEFT '"Destination:"';popasl ID UUD HELP '"Destination File Location"' CONTENT 'Ram:';label LEFT '"Method:"';cycle ID UUM LABELS 'Encode,Decode' ATTRS 0x80421788 HELP '"Encode File or Decode it"';label left '"Archive:"';cycle ID UUA LABELS 'No,lha,lzx' ATTRS 0x80421788 HELP '"Archive the File Prior to Encode"';endgroup;group FRAME Label '"Coder Options"';group ID WHOL REGISTER ATTRS 0x8042e1bf 1 LABELS 'UUxT,Base64,FSCode';group ATTRS 0x8042f416 2;label left '"Split:"';cycle ID UUS LABELS 'NoSplit,25,50,100,150,200,250' ATTRS 0x80421788 HELP '"Split the File into Smaller Chunks"'
  4. label left '"Split Style:"';cycle ID UUL LABELS 'KBytes,Line' ATTRS 0x80421788 HELP '"If Splitting File, Split by Kbytes or Lines"';endgroup;group ATTRS 0x8042f416 2;label LEFT '"Buffer Size:"';cycle ID BAB LABELS '4096,8192,12288,16384,20480,24576,28672,32768' ATTRS 0x80421788 HELP '"Buffer Size during Encode."';label left '"Header:"';cycle ID BAH LABELS 'Yes,No' ATTRS 0x80421788 HELP '"Include MIME Mail Header"';label left '"Minlen:"';cycle ID BML LABELS 'No,Yes' ATTRS 0x80421788 HELP '"Assist with the Decoding from Some Dodgy Coders"';label left '"Autoname:"';cycle ID BIM LABELS 'No,Yes' ATTRS 0x80421788 HELP '"Auto Add Decode File name"';endgroup;group ATTRS 0x8042f416 2;label LEFT '"Multi:"';cycle ID FAB LABELS 'No,Yes' ATTRS 0x80421788 HELP '"Split File into Multiple Parts"';label left '"Lines:"';cycle ID FAH LABELS '25,50,100,150,200,250' ATTRS 0x80421788 HELP '"Number of Lines to Split by if Enabled"';endgroup;endgroup;endgroup;group ID GONZO ATTRS 0x8042f416 2
  5. Button ID BUT PRESS COMMAND '"'Location'CodeControl.rexx GO"' HELP '"Starts the ENcoding/Decoding Process"' LABEL 'Start';endgroup;endgroup;endwindow;exit;end;Address CodeControl;Button ID BUT PRESS COMMAND '"'Location'CodeControl.rexx GO"' ATTRS disabled 2 HELP '"Starts the ENcoding/Decoding Process"' LABEL 'Start';Arci = 0;popasl ID UUF;file = result;group ID WHOL REGISTER;type = result;zob = left(file, 9);if upper(zob) = 'RAM DISK:' then do;len = length(file);sop = right(file,(Len - 9));file = 'Ram:'||sop;end;popasl ID UUD;dest = result;bob = left(dest, 9);if upper(bob) = 'RAM DISK:' then do;len = length(dest);sop = right(dest,(Len - 9));dest = 'Ram:'||sop;end;cycle ID UUM;method = result;cycle ID UUA;arc = result;if arc = 'lha' | arc = 'lzx' then Arci = 1;if ~exists(File) then do;call message5();call Busyexit();end;spam = filepart(File);blam = pathpart(File);Len = Length(blam);Colon = lastpos(':',blam);if Colon ~= Len then do;blam = blam||'/';end;if Spam = '' & method = 'Encode' then do;call message6()
  6. call busyexit();end;Filei = filepart(Dest);Jul = pathpart(Dest);if method = 'Encode' then do;if ~exists(jul) then do;call message2();call busyexit();end;tart = pathpart(dest);if tart = '' then do;call message2();call busyexit();end;if Filei = '' then do;Select;When type = 'UUxT' then Dest = Dest||spam||'.uue';When type = 'FSCode' then Dest = Dest||spam||'.fsc';When type = 'Base64' then Dest = Dest||spam||'.mme';otherwise nop;end;call message8();end;end;if method = 'Decode' then call DecodeCheck();Select;When type = 'UUxT' then call UUxT;When type = 'FSCode' then call FSCode;When type = 'Base64' then call Base64;otherwise nop;end;call busyexit();UUxT:;cycle ID UUL;Style = result;cycle ID UUS;split = result;if split = 'NoSplit' then split = '';else do;if Style = 'Line' then Split = '-s'split'l';else Split = '-s'split'';end;if method = 'Encode' then do;call Archiver(Encode);Address Command 'UUxT >Nil: 'Split' a 'dest' 'File'';if RC = 20 then call message10();if arci = 1 then delete(File);Call Message1();end
  7. if method = 'Decode' then do;call Archiver(Decode);call IsMulti();File = Spam;Locy = pragma(D);Call Pragma(D,blam);Address Command 'UUxT >Nil: x 'File' dest='Dest'';if RC ~= 0 then call message10();Call Pragma(D,Locy);call DestCheck();Call Message7();end;call busyexit();Base64:;cycle ID BAB;buffer = result;cycle ID BAH;header = result;if header = 'Yes' then header = '';else header = NOHEADER;cycle ID BML;minlen = result;if minlen = 'No' then minlen = '';else minlen = USEMINLEN;cycle ID BIM;namey = result;if namey = 'No' then namey = '';else namey = 'AUTONAME';if method = 'Encode' then do;Call Archiver(Encode);Address Command 'Base64Encode >nil: 'File' 'Dest' 'buffer' 'header'';if RC ~= 0 then call message10();if arci = 1 then delete(File);Call Message1();end;if method = 'Decode' then do;call Archiver(Decode);Address Command 'Base64Decode >nil: 'File' 'Dest' 'minlen' 'namey'';if RC ~= 0 then call message10();call DestCheck();Call Message7();end;call busyexit();FSCode:;cycle ID FAB;milti = result
  8. if milti = 'No' then milti = '';else milti = MULTI;cycle ID FAH;lines = result;if milti ~= MULTI then lines = '';else lines = 'L='Lines'';if method = 'Encode' then do;Call Archiver(Encode);Address Command 'FSCode >nil: 'File' E='Dest' 'milti' 'lines'';if RC ~= 0 then call message10();if arci = 1 then delete(File);Call Message1();end;if method = 'Decode' then do;Call Archiver(Decode);File = spam;Call IsMulti();File = Spam;Locy = pragma(D);Call Pragma(D, dest);Address Command 'FScode >nil: 'blam''File' 'milti'';if RC ~= 0 then call message10();call pragma(D, Locy);call DestCheck();call message7();end;call busyexit();Archiver:;Parse Arg Thing;Select;when upper(THING) = 'ENCODE' then do;if arci = 1 then do;call File_Identify(File);Select;When Chk = 'lha' | Chk = 'lzx' then do;Arcfile = File;Arci = 0;end;otherwise do;PFile = filepart(File);Dot = verify(PFile, '.','M');if dot ~= 0 then do;Pfile = left(Pfile,(Dot-1));end;Arcfile = 'T:'PFile'.'Arc'';Address Command ''Arc' >nil: a 'ArcFile' 'File''
  9. if RC ~= 0 then call message10();File = Arcfile;end;end;end;Return;end;when upper(THING) = 'DECODE' then do;dest = pathpart(dest);popasl ID UUD HELP '"Destination File Location"' CONTENT dest;if ~exists(File) then do;call message4();call busyexit();end;if ~exists(dest) then do;call message2();call busyexit();end;return;end;otherwise nop;end;call busyexit();IsMulti:;Select;When type = 'UUxT' then do;Nodot = strip(spam, 'T','.1234567890');spam = NoDot||#?;slap = '';IF GETDIR(blam,spam,'stemvar','F','N') THEN DO;IF QSORT('stemvar','destvar') THEN DO i = 1 TO destvar.0;Slap = strip(slap destvar.i);end;end;spam = slap;return;end;When type = 'FSCode' then do;Nodot = strip(spam, 'T','.1234567890');spam = NoDot||#?;slap = '';IF GETDIR(blam,spam,'stemvar','F','N') THEN DO;IF QSORT('stemvar','destvar') THEN if destvar.0 > 1 then do;spam = strip(destvar.1,'T','1');milti = MULTI;end;if destvar.0 == 1 then do;spam = file;milti = '';end;end;end;otherwise nop;end;return;DecodeCheck:;Select;When type = 'UUxT' then do
  10. Lineck = SEARCHPATTERN(File,'begin',1,'LINE','NOCASE');IF lineck ~= -1 THEN return;Lineck = SEARCHPATTERN(File,'!start',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'FSCode';return;end;Lineck = SEARCHPATTERN(File,'!mstrt',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'FSCode';return;end;Lineck = SEARCHPATTERN(File,'MIME-Version:',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'Base64';return;end;request ID MZIR GADGETS '"Drats"' '"Sorry.  I Don''t Know How to Decode this File."';call busyexit();end;When type = 'Base64' then do;Lineck = SEARCHPATTERN(File,'MIME-Version:',1,'LINE','NOCASE');IF lineck ~= -1 THEN return;Lineck = SEARCHPATTERN(File,'begin',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'UUxT';return;end;Lineck = SEARCHPATTERN(File,'!start',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'FSCode';return;end;Lineck = SEARCHPATTERN(File,'!mstrt',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'FSCode';return;end
  11. request ID MZIR GADGETS '"Drats"' '"Sorry.  I Don''t Know How to Decode this File."';call busyexit();end;When type = 'FSCode' then do;Lineck = SEARCHPATTERN(File,'!start',1,'LINE','NOCASE');IF lineck ~= -1 THEN return;Lineck = SEARCHPATTERN(File,'!mstrt',1,'LINE','NOCASE');IF lineck ~= -1 THEN return;Lineck = SEARCHPATTERN(File,'begin',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'UUxT';return;end;Lineck = SEARCHPATTERN(File,'MIME-Version:',1,'LINE','NOCASE');IF lineck ~= -1 THEN do;type = 'Base64';return;end;request ID MZIR GADGETS '"Drats"' '"Sorry.  I Don''t Know How to Decode this File."';call busyexit();end;otherwise nop;end;return;DestCheck:;call GETDIR(dest,'#?','Arcvar','FILES','P');do i = 1 to arcvar.0;call File_Identify(arcvar.i);If Chk ~= 'Nope' then do;Call Message9(Arcvar.i);if result = 1 then do;Address Command ''Chk' >Nil: x 'arcvar.i' 'Dest'';if RC ~= 0 then call message10();Call Delete(arcvar.i);end;end;end;return;File_Identify:;Parse arg Filey;Comp = FILEID_IDENTIFY(Filey,'ID');Select
  12. When Comp = 71 then Chk = 'lha';When Comp = 543 then Chk = 'lzx';otherwise Chk = 'Nope';end;return Chk;BusyExit:;Location = pragma(D);Len = Length(Location);Colon = lastpos(':',Location);if Colon ~= Len then do;Location = Location||'/';end;Button ID BUT PRESS COMMAND '"'Location'CodeControl.rexx GO"' ATTRS Disabled 0 HELP '"Starts the ENcoding/Decoding Process"' LABEL 'Start';popasl ID UUF HELP '"Source File Location"' CONTENT blam;popasl ID UUD HELP '"Destination File Location"' CONTENT dest;window ID CWIND close;exit;Message1:;request ID MDOR GADGETS '"OK"' '"File 'spam' Successfully Encoded!"';return;Message2:;request ID MDIR GADGETS '"OK"' '"Supplied Destination Path Doesn''t Exist"';return;Message3:;request ID MSIR GADGETS '"OK"' '"You have to Supply a Destination Filename!"';return;Message4:;request ID MDTR GADGETS '"OK"' '"Not a Valid Filename.  Check Spelling?"';return;Message5:;request ID MDAR GADGETS '"OK"' '"Selected File Doesn''t Exist!"';return;Message6:
  13. request ID MDTR GADGETS '"OK"' '"You have to select a source file!"';return;Message7:;request ID MDQR GADGETS '"OK"' '"File Successfully Decoded!"';return;Message8:;request ID MDIR GADGETS '"OK|Cancel"' '"File will be encoded as 'dest'!"';if result = 0 then call busyexit();else;popasl ID UUD HELP '"Destination File Location"' CONTENT dest;return;Message9:;Parse Arg Frile;request ID MBIR GADGETS '"OK|No"' '"'Frile' is a 'Chk' Archive. Extract to 'dest'?"';return result;Message10:;request ID MBIR GADGETS '"Drats"' '"Oh Dear, Something went wrong."';call busyexit()
  14. /* Original script: 669 lines, 16886 bytes */
  15.